home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PXDTUT3.ZIP
/
PXDTUT3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-06-01
|
19KB
|
778 lines
program PXDTUT3;
uses
crt;
CONST
VGA = $a000;
Num_of_points = 8;
Num_of_faces = 6;
Xofs = 160;
yofs = 100;
Zeye = -200;
TYPE
PointT = record
x,y,z : integer;
end; {6 bytes pr point}
ScrPointT = record
x,y : integer; {4 bytes pr point}
end;
FaceT = record
P1,P2,P3,P4 : integer; {9 bytes pr face}
color : byte;
end;
PointRecord = Array[1..Num_of_points] of PointT; {points * 6 bytes}
FaceRecord = Array[1..Num_of_faces] of FaceT; {faces * 9 bytes}
ScrPointRecord = Array[1..Num_of_points] of ScrPointT; {points * 4 bytes}
CenterRecord = Array[1..Num_of_faces] of integer; {faces * 2 bytes}
Virtualscreen = Array[1..64000] of byte;
Virscr = ^VirtualScreen;
VAR
lookup : Array [0..360,1..2] of integer; {Our sin and cos lookup table}
Baseobj : PointRecord; {original 3d-object}
Faces : FaceRecord; {data for how faces is defined}
Points : PointRecord; {rotated 3d-object}
Translated : ScrPointRecord; {the 2d-screenpoints for drawing}
Centers : CenterRecord; {Z-val of centers for depth sorting}
OrderTable : Array[1..Num_of_faces] of integer; {how to handle faces correct}
Xrot,Yrot, Zrot : integer;
scr2 : virscr;
vaddr : word;
PROCEDURE WaitRetrace;
Assembler;
label l1,l2;
asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
END;
Procedure FlipScreen(source, dest : word);
Assembler; {386 only}
asm
mov dx, ds
mov ax, [dest]
mov es, ax
mov ax, [source]
mov ds, ax
xor si, si
xor di, di
mov cx, 16000
db $66
rep movsw
mov ds,dx {mov's are faster than push / pops }
end;
Procedure Clear (Col : Byte;where:word);
Assembler;
asm
mov cx, 32000;
mov ax,where
mov es,ax
xor di,di
mov al,[col]
mov ah,al
rep stosw
END;
Procedure PurplePal;
var
taeller : integer;
begin
for taeller := 0 to 63 do
begin {63 shades from black to purple}
port[$3C8] := taeller;
port[$3C9] := taeller;
port[$3C9] := 0;
port[$3C9] := taeller;
end;
end;
Procedure HorLine(Xbegin, Xend,Ypos : integer;color : byte;where : word);
Assembler;
asm
mov cx,[Xend]
inc cx
sub cx,[Xbegin] {cx = length of line - used for counter }
{note, I assume that Xbegin < Xend - the poly routine}
{will take care of that...}
mov ax,[ypos]
shl ax,8
mov di,ax
shr ax,2
add di,ax
add di,[Xbegin] {di = Ypos * 320 + Xbegin - offset for our line}
mov es,[where] {where to draw..}
mov al,[color]
rep stosb {I draw byte by byte - slower than drawing a word at a}
{time but it is because of the changes we are going to}
{make to this routine when glenzing/gouraud/texturemapping}
end;
PROCEDURE GlenzHorline(xb,xe,y:integer; c:byte;where : word); assembler;
asm
mov bx,[xb]
mov cx,[xe]
inc cx
sub cx,bx { length of line in cx }
mov es,Where { segment to draw in }
mov ax,[y] { heigth of line }
shl ax,8
mov di,ax
shr ax,2
add di,ax { y*320 in di (offset) }
add di,bx { add x-begin }
@again:
mov al,es:[di]
add al,[c]
stosb
dec cx
cmp cx,0
jne @again
@out:
end;
Procedure Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;color : byte; where : word);
var
counter : integer;
Ymin, Ymax : integer;
polygon : Array[0..199,1..2] of integer;
Procedure ScanPolySide(X1,Y1,X2,Y2 : integer);
var
DeltaX : integer;
temp : integer;
Xposfixed,Xpos : integer;
counter : integer;
begin
if Y2=Y1 then exit; {exit if side is a horizontal line }
if (Y2<Y1) then {make sure Y1 is top point}
begin
temp := Y1;
Y1 := Y2;
Y2 := temp;
temp := X1;
X1 := X2;
X2 := temp; {switch the points if Y1 is not top..}
end;
DeltaX := ((X2-X1) shl 7) div (Y2-Y1); {DeltaX in 9.7 fixed point math}
Xposfixed := X1 shl 7; {Xpos in 9.7 fixed point math }
for counter := Y1 to Y2 do
begin
Xpos := XposFixed shr 7;
if (Xpos < polygon[counter,1]) then polygon[counter,1] := Xpos;
if (Xpos > polygon[counter,2]) then polygon[counter,2] := Xpos;
Xposfixed := XposFixed + DeltaX;
end;
end;
begin
Ymin := Y1;
Ymax := Y1;
if (Y2 < Ymin) then Ymin := Y2;
if (Y2 > Ymax) then Ymax := Y2;
if (Y3 < Ymin) then Ymin := Y3;
if (Y3 > Ymax) then Ymax := Y3;
if (Y4 < Ymin) then Ymin := Y4;
if (Y4 > Ymax) then Ymax := Y4; {what is Ymin and Ymax in this polygon ?}
if (Ymin < 0) then Ymin := 0;
if (Ymax > 199) then Ymax := 199;
for counter := 0 to 199 do
begin
polygon[counter,1] := 32000;
polygon[counter,2] := -32000;
end;
{we have to initialize our variable 'polygon' to some extreme values}
ScanPolySide(X1,Y1,X2,Y2);
ScanPolySide(X2,Y2,X3,Y3);
ScanPolySide(X3,Y3,X4,Y4);
ScanPolySide(X4,Y4,X1,Y1); {all four sides scanned}
for counter := Ymin to Ymax do
Horline(polygon[counter,1],polygon[counter,2],counter,color,where);
end;
Procedure GlenzPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;color : byte; where : word);
var
counter : integer;
Ymin, Ymax : integer;
polygon : Array[0..199,1..2] of integer;
Procedure ScanPolySide(X1,Y1,X2,Y2 : integer);
var
DeltaX : integer;
temp : integer;
Xposfixed,Xpos : integer;
counter : integer;
begin
if Y2=Y1 then exit; {exit if side is a horizontal line }
if (Y2<Y1) then {make sure Y1 is top point}
begin
temp := Y1;
Y1 := Y2;
Y2 := temp;
temp := X1;
X1 := X2;
X2 := temp; {switch the points if Y1 is not top..}
end;
DeltaX := ((X2-X1) shl 7) div (Y2-Y1); {DeltaX in 9.7 fixed point math}
Xposfixed := X1 shl 7; {Xpos in 9.7 fixed point math }
for counter := Y1 to Y2 do
begin
Xpos := XposFixed shr 7;
if (Xpos < polygon[counter,1]) then polygon[counter,1] := Xpos;
if (Xpos > polygon[counter,2]) then polygon[counter,2] := Xpos;
Xposfixed := XposFixed + DeltaX;
end;
end;
begin
Ymin := Y1;
Ymax := Y1;
if (Y2 < Ymin) then Ymin := Y2;
if (Y2 > Ymax) then Ymax := Y2;
if (Y3 < Ymin) then Ymin := Y3;
if (Y3 > Ymax) then Ymax := Y3;
if (Y4 < Ymin) then Ymin := Y4;
if (Y4 > Ymax) then Ymax := Y4; {what is Ymin and Ymax in this polygon ?}
if (ymin < 0) then Ymin := 0;
if (Ymax > 199) then Ymax := 199;
for counter := 0 to 199 do
begin
polygon[counter,1] := 32000;
polygon[counter,2] := -32000;
end;
{we have to initialize our variable 'polygon' to some extreme values}
ScanPolySide(X1,Y1,X2,Y2);
ScanPolySide(X2,Y2,X3,Y3);
ScanPolySide(X3,Y3,X4,Y4);
ScanPolySide(X4,Y4,X1,Y1); {all four sides scanned}
for counter := Ymin to Ymax do
GlenzHorline(polygon[counter,1],polygon[counter,2],counter,color,where);
end;
PROCEDURE SetUpVirtual(VAR screenname:virscr;VAR add : word);
BEGIN
GetMem (Screenname,64000);
add := seg (Screenname^);
clear(0,add);
END;
PROCEDURE ShutDown(Screenname:virscr);
BEGIN
FreeMem (Screenname,64000);
END;
Function rad (theta : real) : real;
BEGIN
rad := theta * pi / 180
END;
Procedure Calc_Cos_sin;
var
loop1 : integer;
begin
For loop1:=0 to 360 do
BEGIN
lookup [loop1,1]:=round(sin (rad (loop1))*16384);
lookup [loop1,2]:=round(cos (rad (loop1))*16384);
END;
end;
FUNCTION Xconv(X,Z : integer):integer;
BEGIN
Xconv:=Xofs+Round(X*(Zeye/(Zeye-Z)));
END;
FUNCTION Yconv(Y,Z : integer):integer;
BEGIN
Yconv:=Yofs+Round(Y*(Zeye/(Zeye-Z)));
END;
Procedure Init_Object;
var
taeller : integer;
begin
baseobj[1].X := -50;
baseobj[1].Y := -50;
baseobj[1].Z := -50;
baseobj[2].X := 50;
baseobj[2].Y := -50;
baseobj[2].Z := -50;
baseobj[3].X := -50;
baseobj[3].Y := 50;
baseobj[3].Z := -50;
baseobj[4].X := 50;
baseobj[4].Y := 50;
baseobj[4].Z := -50;
baseobj[5].X := -50;
baseobj[5].Y := -50;
baseobj[5].Z := 50;
baseobj[6].X := 50;
baseobj[6].Y := -50;
baseobj[6].Z := 50;
baseobj[7].X := -50;
baseobj[7].Y := 50;
baseobj[7].Z := 50;
baseobj[8].X := 50;
baseobj[8].Y := 50;
baseobj[8].Z := 50;
faces[1].P1 := 1;
faces[1].P2 := 2;
faces[1].P3 := 4;
faces[1].P4 := 3;
faces[2].P1 := 2;
faces[2].P2 := 6;
faces[2].P3 := 8;
faces[2].P4 := 4;
faces[3].P1 := 5;
faces[3].P2 := 7;
faces[3].P3 := 8;
faces[3].P4 := 6;
faces[4].P1 := 1;
faces[4].P2 := 3;
faces[4].P3 := 7;
faces[4].P4 := 5;
faces[5].P1 := 1;
faces[5].P2 := 5;
faces[5].P3 := 6;
faces[5].P4 := 2;
faces[6].P1 := 3;
faces[6].P2 := 4;
faces[6].P3 := 8;
faces[6].P4 := 7;
for taeller := 1 to Num_of_faces do
faces[taeller].color := 0 + taeller * 3;
end;
Procedure RotatePoint (Xrot,Yrot,Zrot,Xin,Yin,Zin:Integer;var Xout,Yout,Zout : integer);
VAR
a,b,c:integer;
BEGIN
b:=lookup[Yrot,2];
c:=Xin;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Yrot,1];
c:=Zin;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
Xout:=a;
Yout:=Yin;
b:=-lookup[Yrot,1];
c:=Xin;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Yrot,2];
c:=Zin;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
Zout:=a;
if (Xrot<>0) THEN
BEGIN
b:=lookup[Xrot,2];
c:=Yout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Xrot,1];
c:=Zout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[Xrot,1];
c:=Yout;
Yout:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Xrot,2];
c:=Zout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
Zout:=a;
END; {if Xrot <> 0 }
if (Zrot<>0) THEN
BEGIN
b:=lookup[Zrot,2];
c:=Xout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Zrot,1];
c:=Yout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[Zrot,1];
c:=Xout;
Xout:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[Zrot,2];
c:=Yout;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
Yout:=a;
END; {if Zrot <> 0 }
END; {This one I grapped from some Asphyxia tuturial.... thnx Denthor }
Procedure Rotateobj(x,y,z : integer);
{Rotates all points and calculates center Z-val for sorting}
var
taeller : integer;
begin
for taeller := 1 to num_of_points do
RotatePoint(x,y,z,baseobj[taeller].x,baseobj[taeller].y,baseobj[taeller].z,
points[taeller].x,points[taeller].y,points[taeller].z);
for taeller := 1 to num_of_faces do
centers[taeller] :=
(points[faces[taeller].P1].Z + points[faces[taeller].P2].Z +
points[faces[taeller].P3].Z + points[faces[taeller].P4].Z);
{average Z-val for face. NOTE : SHOULD divide by 4.. but that is really}
{not nessesary. This way all the values will be the correct val times 4}
{As ALL values is 4 times too big they will still sort correct :) }
end;
Procedure Sort_faces;
{Just a simple bubble-sort - not to fast but what the heck :) }
{Faces with the HIGHEST Z-val is placed first in Order[] }
VAR
counter : integer;
position : integer;
tempval : integer;
BEGIN
for counter:=1 to Num_of_faces do BEGIN
OrderTable[counter]:=counter;
END;
{we resets the ordertable so that it matches the unsorted 'centers' variable}
position := 1;
repeat
if (centers[position] < centers[position+1]) then
BEGIN {switch values in centers and ordertable}
tempval := Centers[position+1];
Centers[position+1] := centers[position];
centers[position] := tempval;
tempval := OrderTable[position+1];
OrderTable[position+1] := OrderTable[position];
OrderTable[position] := tempval;
position:=1; {start loop over}
END;
inc(position);
until (position = Num_of_faces); {all way through without changes}
END;
Procedure Project_points;
var
taeller : integer;
begin
for taeller := 1 to Num_of_points do
begin
translated[taeller].X := Xconv(points[taeller].X,points[taeller].Z);
translated[taeller].Y := Yconv(points[taeller].Y,points[taeller].Z);
end;
end;
Procedure Do_faces(where : word);
{This one can be used for all kinds of fills : solid, textures, glenz...}
var
taeller : integer;
X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
color : byte;
polynr : integer;
normal : integer;
begin
for taeller := 1 to Num_of_faces do
begin
polynr := OrderTable[taeller];
X1 := translated[faces[polynr].P1].X;
Y1 := translated[faces[polynr].P1].Y;
X2 := translated[faces[polynr].P2].X;
Y2 := translated[faces[polynr].P2].Y;
X3 := translated[faces[polynr].P3].X;
Y3 := translated[faces[polynr].P3].Y;
X4 := translated[faces[polynr].P4].X;
Y4 := translated[faces[polynr].P4].Y;
color := faces[polynr].color;
{*******************************************************}
{******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
{*******************************************************}
{Z-Comp of normal}
normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
if (normal < 0) then
Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
{*******************************************************}
{*******************************************************}
{*******************************************************}
end;
end;
Procedure DoGlenzing(where : word);
var
taeller : integer;
X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
color : byte;
begin
for taeller := 1 to Num_of_faces do
begin
X1 := translated[faces[taeller].P1].X;
Y1 := translated[faces[taeller].P1].Y;
X2 := translated[faces[taeller].P2].X;
Y2 := translated[faces[taeller].P2].Y;
X3 := translated[faces[taeller].P3].X;
Y3 := translated[faces[taeller].P3].Y;
X4 := translated[faces[taeller].P4].X;
Y4 := translated[faces[taeller].P4].Y;
color := faces[taeller].color;
GlenzPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
end;
end;
BEGIN
Clrscr;
Writeln(' ****************************************************************');
Writeln(' * *');
Writeln(' * 3D BASIC OBJECT ENGINE *');
Writeln(' * by : Telemachos *');
Writeln(' * *');
Writeln(' ****************************************************************');
Writeln;
Writeln;
Writeln(' Hiya! ');
Writeln(' Welcome to the Peroxide Programming Tips #3');
Writeln(' This one is on 3D objects - starting out with the basics of 3D');
Writeln(' programming.');
Writeln;
Writeln(' This small demo contains two small parts. The first is a demo ');
Writeln(' of the theory on face sorting and hidden face removal we learned');
Writeln(' in the textfile.');
Writeln(' The other part is a demo of the glenzing effect.');
Writeln(' Press any key to change from the first to the second part..');
Writeln;
Writeln(' Hit any key to start.....');
readkey;
asm
mov ax,13h
int 10h
end;
SetupVirtual(scr2,vaddr);
Calc_cos_sin;
Init_Object;
Clear(0,VGA);
Xrot := 0;
Yrot := 0;
Zrot := 0;
repeat
Rotateobj(Xrot,Yrot,Zrot);
Xrot := (Xrot + 2) mod 360;
Yrot := (Yrot + 4) mod 360;
Zrot := (Zrot + 1) mod 360;
Clear(0,Vaddr);
Project_Points;
Sort_faces;
Do_faces(Vaddr);
waitretrace;
FlipScreen(vaddr,VGA);
until keypressed;
readkey;
PurplePal; {set up linear pallette for glenzing... not the best way to glenz}
repeat
Rotateobj(Xrot,Yrot,Zrot);
Xrot := (Xrot + 2) mod 360;
Yrot := (Yrot + 4) mod 360;
Zrot := (Zrot + 1) mod 360;
Clear(0,Vaddr);
Project_Points;
DoGlenzing(vaddr);
waitretrace;
FlipScreen(vaddr,VGA);
until keypressed;
readkey;
ShutDown(scr2);
asm
mov ax,03h
int 10h
end;
END.